home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / faq-s.zip / OVERRET1.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-16  |  31KB  |  1,004 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N- }
  2. {$M 65500,0,0 }
  3.  
  4. unit overret1;
  5.  
  6. interface
  7.  
  8. uses crt,nuv,
  9.      gentypes,modem,configrt,gensubs,subs1,subs2,userret,textret,flags,mainr1;
  10.  
  11. procedure edituser (eunum:integer);
  12. procedure printnews;
  13. procedure sendmodemstr (ss:anystr; endifcarrier:boolean);
  14. function getlastcaller:mstr;
  15. procedure showlastcallers;
  16. procedure infoform (i:integer);
  17. function selectspecs (var us:userspecsrec):boolean; { True if user aborts }
  18. procedure editoldspecs;
  19.  
  20. implementation
  21.  
  22. var buflen30:boolean;
  23.  
  24. {procedure help (fn:mstr);
  25. var tf:text;
  26.     htopic,cnt:integer;
  27. begin
  28.   fn:=textfiledir+fn;
  29.   assign (tf,fn);
  30.   reset (tf);
  31.   if ioresult<>0 then begin
  32.     writestr ('Sorry, no help is availiable!');
  33.     if issysop then begin
  34.       writeln ('Sysop: To make help, create a file called ',fn);
  35.       writeln ('Group the lines into blocks separated by periods.');
  36.       writeln ('The first group is the topic menu; the second is the');
  37.       writeln ('help for topic 1; the third for topic 2; etc.')
  38.     end;
  39.     exit
  40.   end;
  41.   repeat
  42.     textclose (tf);
  43.     assign (tf,fn);
  44.     reset (tf);
  45.     writeln (^M);
  46.     printtexttopoint (tf);
  47.     repeat
  48.       writestr (^M'Topic Number [CR/Quit]:');
  49.       if hungupon or (length(input)=0) then
  50.         begin
  51.           textclose (tf);
  52.           exit
  53.         end;
  54.       htopic:=valu (input)
  55.     until (htopic>0);
  56.     for cnt:=2 to htopic do
  57.       if not eof(tf)
  58.         then skiptopoint (tf);
  59.     if eof(tf)
  60.       then writestr ('Sorry, no help on that topic!')
  61.       else printtexttopoint (tf)
  62.   until 0=1
  63. end;}
  64.  
  65. procedure edituser (eunum:integer);
  66. var eurec:userrec;
  67.     ca:integer;
  68.     k:char;
  69. const sysopstr:array [false..true] of string[6]=('Normal','Sysop');
  70.       sectionnames:array [udsysop..gfsysop] of string[20]=
  71.         ('File transfer','Bulletin section','Voting booths',
  72.          'E-mail section','Doors','Main menu','Databases','Trivia','G-Files');
  73.  
  74.   procedure truesysops;
  75.   begin
  76.     writeln ('Sorry, you may not do that without true sysop access!');
  77.     writelog (18,17,'')
  78.   end;
  79.  
  80.   function truesysop:boolean;
  81.   begin
  82.     truesysop:=ulvl<>sysoplevel
  83.   end;
  84.  
  85. procedure eustatus;
  86.  
  87. var vot:integer;
  88. var lev:real;
  89. begin
  90.  
  91.  clearscr;
  92.  movexy (1,8);
  93.    writeln (^R'                    ╔═════════════════════════════════════╗');
  94.    writeln (^R'                    ║        '^P'   User Main Level'^R'           ║');
  95.    writeln (^R'                    ║ '^P'Name'^R'          :                     ║');
  96.    writeln (^R'                    ║ '^P'Note'^R'          :                     ║');
  97.    writeln (^R'                    ║ '^P'Level'^R'         :                     ║');
  98.    writeln (^R'                    ║ '^P'Password'^R'      :                     ║');
  99.    writeln (^R'                    ║ '^P'Phone'^R'         :                     ║');
  100.    writeln (^R'                    ║ '^P'Time on'^R'       :                     ║');
  101.    writeln (^R'                    ║ '^P'Time Left'^R'     :                     ║');
  102.    writeln (^R'                    ║ '^P'Voting Record'^R' :                     ║');
  103.    writeln (^R'                    ║ '^P'Wanted Status'^R' :                     ║');
  104.      if useqr then begin
  105.  with eurec do begin
  106.   qr := qrmultifactor*(eurec.uploads+eurec.nbu)-eurec.downloads;
  107.  end;
  108.    writeln (^R'                    ║ '^P'Quality Rating'^R':                     ║');
  109.   end;
  110.    writeln (^R'                    ╚═════════════════════════════════════╝');
  111.   printxy (39,10,eurec.handle);
  112.   printxy (39,11,eurec.note);
  113.   printxy (39,12,strr(eurec.level));
  114.   printxy (39,13,eurec.password);
  115.   printxy (39,14,eurec.phonenum);
  116.   printxy (39,15,streal(eurec.totaltime));
  117.   printxy (39,16,strr(eurec.timetoday));
  118.   movexy (1,17);
  119.    write (^R'                    ║ '^P'Voting Record'^R' : ');
  120.    for vot:=1 to maxtopics do begin          { x,y = 38,18 }
  121.       if vot<>1 then write (',');
  122.      write (^S,eurec.voted[vot]);
  123.    end;
  124.   printxy (39,18,yesno(wanted in eurec.config)+^R);
  125.   if useqr then begin
  126.  with eurec do begin
  127.   qr := qrmultifactor*(eurec.uploads+eurec.nbu)-eurec.downloads;
  128.  end;
  129.    printxy (39,19,strr(qr));
  130.   end;
  131.   printxy (1,1,^R+'╔══════════════════════════════════════════════════════════════════════════════╗');
  132.   printxy (1,2,^R+'║                            '^P'File Transfer Section'^R'                             ║');
  133.   printxy (1,3,^R+'║ '^P'Transfer Level '^R':                         '^P'Uploaded K  '^R':                       ║');
  134.   printxy (1,4,^R+'║ '^P'Transfer Points'^R':                         '^P'Downloaded K'^R':                       ║');
  135.   printxy (1,5,^R+'║ '^P'Uploads        '^R':                         '^P'File K Ratio'^R':                       ║');
  136.   printxy (1,6,^R+'║ '^P'Downloads      '^R':                         '^P'U/D Ratio   '^R':                       ║');
  137.   printxy (1,7,^R+'╚══════════════════════════════════════════════════════════════════════════════╝');
  138.   printxy (20,3,strr(eurec.udlevel));
  139.   printxy (20,4,strr(eurec.udpoints));
  140.   printxy (20,5,strr(eurec.uploads));
  141.   printxy (20,6,strr(eurec.downloads));
  142.   printxy (58,3,streal(eurec.upk/1000));
  143.   printxy (58,4,streal(eurec.downk/1000));
  144.   printxy (58,5,streal(ratio(eurec.upk,eurec.downk))+'%');
  145.   printxy (58,6,strr(percent(eurec.uploads,eurec.downloads))+'%');
  146.   printxy (1,09,^R'┌──────────────────┐');
  147.   printxy (1,10,^R'│ '^P'Level '^R'   :       │');
  148.   printxy (1,11,^R'│ '^P'Uploads  '^R':       │');
  149.   printxy (1,12,^R'│ '^P'Downloads'^R':       │');
  150.   printxy (1,13,^R'│ '^P'Ratio '^R'   :       │');
  151.   printxy (1,14,^R'└──────────────────┘');
  152.   printxy (14,10,strr(eurec.gflevel));
  153.   printxy (14,11,strr(eurec.gfuploads));
  154.   printxy (14,12,strr(eurec.gfdownloads));
  155.   printxy (14,13,strr(percent(eurec.gfuploads,eurec.gfdownloads))+'%');
  156.   printxy (60,09,^R'┌───────────────────┐');
  157.   printxy (60,10,^R'│ '^P'Posts'^R'    :        │');
  158.   printxy (60,11,^R'│ '^P'Calls'^R'    :        │');
  159.   printxy (60,12,^R'│ '^P'PCR  '^R'    :        │');
  160.   printxy (60,13,^R'│ '^P'Last Date'^R':        │');
  161.   printxy (60,14,^R'│ '^P'Last Time'^R':        │');
  162.   printxy (60,15,^R'└───────────────────┘');
  163.   printxy (73,10,strr(eurec.nbu));
  164.   printxy (73,11,strr(eurec.numon));
  165.   printxy (73,12,strr(percent(eurec.nbu,eurec.numon))+'%');
  166.   if laston<>0 then printxy (73,13,datestr(eurec.laston)) else
  167.          printxy (73,13,'None.');
  168.   if laston<>0 then printxy (73,14,timestr(eurec.laston)) else
  169.          printxy (73,14,'None.');
  170.   movexy (1,20);
  171.    end;
  172.  
  173.   procedure getmstr (t:mstr; var mm);
  174.   var m:mstr absolute mm;
  175.   begin
  176.     writeln ('Old ',t,': '^S,m);
  177.     if buflen30 then buflen:=30;
  178.     writestr ('New '+t+'? *');
  179.     if length(input)>0 then m:=input
  180.   end;
  181.  
  182.   procedure getsstr (t:mstr; var s:sstr);
  183.   var m:mstr;
  184.   begin
  185.     m:=s;
  186.     getmstr (t,m);
  187.     s:=m
  188.   end;
  189.  
  190.   procedure getint (t:mstr; var i:integer);
  191.   var m:mstr;
  192.   begin
  193.     m:=strr(i);
  194.     getmstr (t,m);
  195.     i:=valu(m)
  196.   end;
  197.  
  198.   procedure euwanted;
  199.   begin
  200.     writestr ('Wanted status: '^S+yesno(wanted in eurec.config));
  201.     writestr ('New wanted status:');
  202.     if yes
  203.       then eurec.config:=eurec.config+[wanted]
  204.       else eurec.config:=eurec.config-[wanted];
  205.     writelog (18,1,yesno(wanted in eurec.config))
  206.   end;
  207.  
  208.   procedure eudel;
  209.   begin
  210.     writestr ('Delete User? [y/n]: *');
  211.     if yes then begin
  212.       deleteuser (eunum);
  213.       nuvit;
  214.       seek (ufile,eunum);
  215.       read (ufile,eurec);
  216.       writelog (18,9,'')
  217.     end
  218.   end;
  219.  
  220.   procedure euname;
  221.   var m:mstr;
  222.   begin
  223.     m:=eurec.handle;
  224.     getmstr ('name',m);
  225.     if not match (m,eurec.handle) then
  226.       if lookupuser (m)<>0 then begin
  227.         writestr ('Already exists!  Are you sure [y/n]? *');
  228.         if not yes then exit
  229.       end;
  230.     eurec.handle:=m;
  231.     writelog (18,6,m)
  232.   end;
  233.  
  234.   procedure eupassword;
  235.   begin
  236.     if not truesysop
  237.       then truesysops
  238.       else begin
  239.         getsstr ('Password',eurec.password);
  240.         writelog (18,8,'')
  241.       end
  242.   end;
  243.  
  244.   procedure eulevel;
  245.   var n:integer;
  246.   begin
  247.     n:=eurec.level;
  248.     getint ('Level',n);
  249.     if (n>=sysoplevel) and (not truesysop)
  250.       then truesysops
  251.       else begin
  252.         eurec.level:=n;
  253.         writelog (18,15,strr(n))
  254.       end
  255.   end;
  256.  
  257.   procedure eugflevel;
  258.   var n:integer;
  259.   begin
  260.     n:=eurec.gflevel;
  261.     getint ('G-File Level',n);
  262.     if (n>=sysoplevel) and (not truesysop)
  263.       then truesysops
  264.       else begin
  265.         eurec.gflevel:=n;
  266.         writelog (18,18,strr(n))
  267.       end
  268.   end;
  269.  
  270.   procedure euphone;
  271.   var m:mstr;
  272.       p:integer;
  273.   begin
  274.     m:=eurec.phonenum;
  275.     buflen:=15;
  276.     getmstr ('Phone Number',m);
  277.     p:=1;
  278.     while p<=length(m) do
  279.       if (m[p] in ['0'..'9'])
  280.         then p:=p+1
  281.         else delete (m,p,1);
  282.     if length(m)>7 then begin
  283.       eurec.phonenum:=m;
  284.       writelog (18,16,m)
  285.     end
  286.   end;
  287.  
  288.   procedure eunote;
  289.   var ax:mstr;
  290.   begin
  291.    buflen30:=true;
  292.    getmstr ('User Note',eurec.note);
  293.    buflen30:=false;
  294.    writeurec;
  295.   end;
  296.  
  297.   procedure boardflags;
  298.   var quit:boolean;
  299.  
  300.     procedure listflags;
  301.     var bd:boardrec;
  302.         cnt:integer;
  303.     begin
  304.       seek (bdfile,0);
  305.       for cnt:=0 to filesize(bdfile)-1 do begin
  306.         read (bdfile,bd);
  307.         tab (bd.shortname,9);
  308.         tab (bd.boardname,30);
  309.         writeln (accessstr[getuseraccflag (eurec,cnt)]);
  310.         if break then exit
  311.       end
  312.     end;
  313.  
  314.     procedure changeflag;
  315.     var bn,q:integer;
  316.         bname:mstr;
  317.         ac:accesstype;
  318.     begin
  319.       buflen:=8;
  320.       writestr ('Board to change access:');
  321.       bname:=input;
  322.       bn:=searchboard(input);
  323.       if bn=-1 then begin
  324.         writeln ('Not found!');
  325.         exit
  326.       end;
  327.       writeln (^B^M'Current access: '^S,
  328.                accessstr[getuseraccflag (eurec,bn)]);
  329.       getacflag (ac,input);
  330.       if ac=invalid then exit;
  331.       setuseraccflag (eurec,bn,ac);
  332.       case ac of
  333.         letin:q:=2;
  334.         keepout:q:=3;
  335.         bylevel:q:=4
  336.       end;
  337.       writelog (18,q,bname)
  338.     end;
  339.  
  340.     procedure allflags;
  341.     var ac:accesstype;
  342.     begin
  343.       writehdr ('Set all board access flags');
  344.       getacflag (ac,input);
  345.       if ac=invalid then exit;
  346.       writestr ('Confirm [Y/N]:');
  347.       if not yes then exit;
  348.       setalluserflags (eurec,ac);
  349.       writelog (18,5,accessstr[ac])
  350.     end;
  351.  
  352.   begin
  353.     opentempbdfile;
  354.     quit:=false;
  355.     repeat
  356.       repeat
  357.         writestr (^M'[L]ist flags, [C]hange one flag, [A]ll flags, or [Q]uit:');
  358.         if hungupon then exit
  359.       until length(input)<>0;
  360.       case upcase(input[1]) of
  361.         'L':listflags;
  362.         'C':changeflag;
  363.         'A':allflags;
  364.         'Q':quit:=true
  365.       end
  366.     until quit;
  367.     closetempbdfile
  368.   end;
  369.  
  370.   procedure specialsysop;
  371.  
  372.     procedure getsysop (c:configtype);
  373.     begin
  374.       writeln ('Section ',sectionnames[c],': '^S,
  375.                sysopstr[c in eurec.config]);
  376.       writestr ('Grant Sysop Access? *');
  377.       if length(input)<>0
  378.         then if yes
  379.           then
  380.             begin
  381.               eurec.config:=eurec.config+[c];
  382.               writelog (18,10,sectionnames[c])
  383.             end
  384.           else
  385.             begin
  386.               eurec.config:=eurec.config-[c];
  387.               writelog (18,11,sectionnames[c])
  388.             end
  389.     end;
  390.  
  391.   begin
  392.     if not truesysop then begin
  393.       truesysops;
  394.       exit
  395.     end;
  396.     writestr
  397. ('Section of [M]ain, [F]ile, [B]ulletin, [V]oting, [E]mail, [D]atabase,'^M+
  398.  '           [O]Doors, [G]-Files, [J]Trivia: *');
  399.     if length(input)=0 then exit;
  400.     case upcase(input[1]) of
  401.       'M':getsysop (mainsysop);
  402.       'F':getsysop (udsysop);
  403.       'B':getsysop (bulletinsysop);
  404.       'V':getsysop (votingsysop);
  405.       'E':getsysop (emailsysop);
  406.       'D':getsysop (databasesysop);
  407.       'O':getsysop (doorssysop);
  408.       'G':getsysop (gfsysop);
  409.       'J':getsysop (jsysop)
  410.     end
  411.   end;
  412.  
  413.   procedure getlogint (prompt:mstr; var i:integer; ln:integer);
  414.   begin
  415.     getint (prompt,i);
  416.     writelog (18,ln,strr(i))
  417.   end;
  418.  
  419.   procedure specialediting;
  420.   begin
  421.    writestr ('Number of Uploads    : *');
  422.    if (length(input)>0) and (valu(input)>-1) then
  423.     eurec.uploads:=valu(input);
  424.    writestr ('Number of Downloads  : *');
  425.    if (length(input)>0) and (valu(input)>-1) then
  426.     eurec.downloads:=valu(input);
  427.    writestr ('Uploaded Kilobytes   : *');
  428.    if yes then urec.upk:=0;
  429.    writestr ('Downloaded Kilobytes : *');
  430.    if yes then urec.downk:=0;
  431.    writeufile (eurec,eunum);
  432.   end;
  433.  
  434.   procedure conaccess;
  435.   var q:char;
  436.   begin
  437.   repeat
  438.   write ('[1] Conference #1 Message: ');
  439.   if eurec.defcon[1] then writeln ('TRUE') else writeln ('FALSE');
  440.   write ('[2] Conference #2 Message: ');
  441.   if eurec.defcon[2] then writeln ('TRUE') else writeln ('FALSE');
  442.   write ('[3] Conference #3 Message: ');
  443.   if eurec.defcon[3] then writeln ('TRUE') else writeln ('FALSE');
  444.   write ('[4] Conference #4 Message: ');
  445.   if eurec.defcon[4] then writeln ('TRUE') else writeln ('FALSE');
  446.   write ('[5] Conference #5 Message: ');
  447.   if eurec.defcon[5] then writeln ('TRUE') else writeln ('FALSE');
  448.   write ('[6] Conference #1 Xfer   : ');
  449.   if eurec.defcon[6] then writeln ('TRUE') else writeln ('FALSE');
  450.   write ('[7] Conference #2 Xfer   : ');
  451.   if eurec.defcon[7] then writeln ('TRUE') else writeln ('FALSE');
  452.   write ('[8] Conference #3 Xfer   : ');
  453.   if eurec.defcon[8] then writeln ('TRUE') else writeln ('FALSE');
  454.   write ('[9] Conference #4 Xfer   : ');
  455.   if eurec.defcon[9] then writeln ('TRUE') else writeln ('FALSE');
  456.   write ('[0] Conference #5 Xfer   : ');
  457.   if eurec.defcon[10] then writeln ('TRUE') else writeln ('FALSE');
  458.   writestr (^M'Conference Access, [Q]uit: *');
  459.   q:=upcase(input[1]);
  460.   case q of
  461.   '1':if not eurec.defcon[1] then eurec.defcon[1]:=true else eurec.defcon[1]:=false;
  462.   '2':if not eurec.defcon[2] then eurec.defcon[2]:=true else eurec.defcon[2]:=false;
  463.   '3':if not eurec.defcon[3] then eurec.defcon[3]:=true else eurec.defcon[3]:=false;
  464.   '4':if not eurec.defcon[4] then eurec.defcon[4]:=true else eurec.defcon[4]:=false;
  465.   '5':if not eurec.defcon[5] then eurec.defcon[5]:=true else eurec.defcon[5]:=false;
  466.   '6':if not eurec.defcon[6] then eurec.defcon[6]:=true else eurec.defcon[6]:=false;
  467.   '7':if not eurec.defcon[7] then eurec.defcon[7]:=true else eurec.defcon[7]:=false;
  468.   '8':if not eurec.defcon[8] then eurec.defcon[8]:=true else eurec.defcon[8]:=false;
  469.   '9':if not eurec.defcon[9] then eurec.defcon[9]:=true else eurec.defcon[9]:=false;
  470.   '0':if not eurec.defcon[10] then eurec.defcon[10]:=true else eurec.defcon[10]:=false;
  471.   end
  472.   until (q=upcase('Q'));
  473. end;
  474.  
  475. var q,cnt:integer;
  476. begin
  477.   writeurec;
  478.   seek (ufile,eunum);
  479.   read (ufile,eurec);
  480.   writelog (2,3,eurec.handle);
  481.   writeln (^R'Editing User - '+^S+eurec.handle+^R);
  482.   repeat
  483.     q:=menu('User Edit','UEDIT','SDHPLOEWTBQYNIRG!VC?');
  484.     case q of
  485.       1:eustatus;
  486.       2:eudel;
  487.       3:euname;
  488.       4:eupassword;
  489.       5:eulevel;
  490.       6:getlogint ('File Points',eurec.udpoints,7);
  491.       7:getlogint ('File Level',eurec.udlevel,14);
  492.       8:euwanted;
  493.       9:getlogint ('Time left for today',eurec.timetoday,12);
  494.       10:boardflags;
  495.       12:specialsysop;
  496.       13:euphone;
  497.       14:showinfoforms(strr(eunum));
  498.       15:eunote;
  499.       16:eugflevel;
  500.       17:specialediting;
  501.       18:begin eurec.level:=qvmainl;
  502.             eurec.udlevel:=qvxferl;
  503.             eurec.udpoints:=qvxferp;
  504.             eurec.gflevel:=qvgfile;
  505.             eurec.note:=qvnote;
  506.             cnt:=eurec.level;
  507.             if cnt<1 then cnt:=1;
  508.             if cnt>100 then cnt:=100;
  509.             eurec.timetoday:=usertime[cnt];
  510.             writeufile (eurec,eunum);
  511.             writeln ('User Quick-Validated.');
  512.          end;
  513.       19:conaccess;
  514.       20:begin
  515. writeln ('C╔═════════════════════════════════════╗Hs');
  516. writeln ('uC║ User Edit Section                   ║Hs');
  517. writeln ('uC╚═════════════════════════════════════╝HHC╔═════s');
  518. writeln ('u════════════════════════════════╗HC║ [B]  s');
  519. writeln ('uEdit User Sub-Board Flags      ║HC║ [Cs');
  520. writeln ('u]  Conference Access              ║HC║ [s');
  521. writeln ('uD]  Delete User                    ║Hs');
  522. writeln ('uC║ [E]  Edit Xfer Level                s');
  523. writeln ('u║HC║ [G]  Edit G-File Level             s');
  524. writeln ('u ║HC║ [H]  Change User ID          s');
  525. writeln ('u       ║HC║ [I]  Show Infoforms    s');
  526. writeln ('u             ║HC║ [L]  Edit Main Les');
  527. writeln ('uvel                ║HC║ [N]  Edit Ps');
  528. writeln ('uhone Number    ╔═════════════════════════════════════╗');
  529. writeln ('HC║ [O]  Edit Xfer Points     s');
  530. writeln ('u║ [R]  Edit User Note                 ║');
  531. writeln ('HC║ [P]  Change Password      s');
  532. writeln ('u║ [S]  Show Statistics                ║');
  533. writeln ('HC║ [Q]  Quit                 s');
  534. writeln ('u║ [T]  Edit Time                      ║');
  535. writeln ('HC╚═══════════════════════════║ [Vs');
  536. writeln ('u]  Quick Validate User            ║HC║ s');
  537. writeln ('u[W]  Edit Wanted Flag               ║Hs');
  538. writeln ('uC║ [Y]  Edit Sysop Status              s');
  539. writeln ('u║HC║ [?]  View This Menu          s');
  540. writeln ('u       ║HC╚═════════════════════════════════════╝');
  541. write (^B^R' '^M);
  542. pause;
  543.            end;
  544.     end
  545.   until hungupon or (q=11);
  546.   writeufile (eurec,eunum);
  547.   readurec
  548. end;
  549.  
  550.   Procedure printnews;
  551.     Var nfile:File Of newsrec;
  552.       line:Integer;
  553.       Ntmp:newsrec;cnt:Integer;
  554.     Begin
  555.       Assign(nfile,bbsdatadir+'News.dat');
  556.       Reset(nfile);
  557.       If IOResult<>0 Then exit;
  558.       If FileSize(nfile)=0 Then Begin
  559.         Close(nfile);
  560.         exit
  561.       End;
  562.       writeln('News: [Ctrl-X] to abort');
  563.       cnt:=0;
  564.       While Not(EoF(nfile) Or break Or hungupon) Do Begin
  565.         Read(nfile,Ntmp);
  566.         If (ntmp.location>=0) And (ntmp.maxlevel>=urec.level) And (urec.level>=ntmp.level) Then Begin
  567.           inc(cnt);
  568.         WriteLn(^B'News Item #'^S,cnt,^R' - "'^S,ntmp.title,^R'" from '^S,ntmp.from,^R'');
  569.         WriteLn(^B'Date: ['^S,datestr(ntmp.when),^R']    Level ['^S,ntmp.level,' - ',ntmp.maxlevel,^R']');
  570.           printtext(Ntmp.location);
  571.           writestr (^M^P'['^R'Enter'^P']'^S': '^U'*')
  572.         End;
  573.       End;
  574.       Close(nfile)
  575.     End;
  576.  
  577. procedure sendmodemstr (ss:anystr; endifcarrier:boolean);
  578. var cnt,ptr:integer;
  579.     k:char;
  580.  
  581. procedure sendit (s:char);
  582. begin
  583.  sendchar (s);
  584. end;
  585.  
  586. begin
  587.   ptr:=0;
  588.   for ptr:=1 to length(ss) do
  589.       begin
  590.       if keyhit or (carrier=endifcarrier) then exit;
  591.       k:=ss[ptr];
  592.       case k of
  593.         '|':sendit (^M);
  594.         '~':delay (500);
  595.         '^':begin
  596.               ptr:=ptr+1;
  597.               if ptr>length(ss)
  598.                 then k:='^'
  599.                 else k:=upcase(ss[ptr]);
  600.               if k in ['A'..'Z']
  601.                 then sendit (chr(ord(k)-64))
  602.                 else sendit (k)
  603.         end;
  604.         else sendit(k);
  605.        end;
  606.        delay(50);
  607.        end;
  608.  
  609.     end;
  610.  
  611. function getlastcaller:mstr;
  612. var qf:file of lastrec;
  613.     l:lastrec;
  614. begin
  615.   getlastcaller:='';
  616.   assign (qf,bbsdatadir+'Callers.dat');
  617.   reset (qf);
  618.   if ioresult=0 then
  619.     if filesize(qf)>0
  620.       then
  621.         begin
  622.           seek (qf,0);
  623.           read (qf,l);
  624.           getlastcaller:=l.name
  625.         end;
  626.   close (qf)
  627. end;
  628.  
  629. {procedure showlastcallers;
  630. var qf:file of lastrec;
  631.     cnt:integer;
  632.     l:lastrec;
  633. begin
  634.   if ulvl<listuserlvl then exit;
  635.   assign (qf,bbsdatadir+'Callers.dat');
  636.   reset (qf);
  637.   if ioresult=0 then begin
  638.     writehdr ('Recent Caller List');
  639.     break:=false;
  640.     writeln ('Name                            Date   Time');
  641.     if (asciigraphics in urec.config) then
  642.     writeln ('──────────────────────────────────────────────') else
  643.     writeln ('----------------------------------------------');
  644.     for cnt:=0 to filesize(qf)-1 do
  645.       if not break then begin
  646.         read (qf,l);
  647.         ansicolor (urec.statcolor);
  648.         tab (l.name,31);
  649.         ansicolor (urec.regularcolor);
  650.         writeln (datestr(l.when)+' '+timestr(l.when))
  651.       end
  652.   end;
  653.   close (qf)
  654. end;}
  655.  
  656.   Procedure showlastcallers;
  657.     Var qf:File Of lastrec;
  658.       cnt:Integer;
  659.       l:lastrec;
  660.     Begin
  661.       if ulvl<listuserlvl then begin
  662.         reqlevel (listuserlvl);
  663.         exit; end;
  664.       Assign(qf,bbsdatadir+'Callers.dat');
  665.       Reset(qf);
  666.       If ioresult=0 Then Begin
  667.         writehdr('Recent Caller List');
  668.     writeln (^P'┌──────────────────────────────────┬────────────┬────────────┬────────────┐');
  669.     writeln (^P'│ '^R'User Handle                      '^P'│ '^R'Date       '^P'│ '^R'Time       '+
  670.         ^P'│ '^R'Baud Rate  '^P'│');
  671.     writeln (^P'├──────────────────────────────────┼────────────┼────────────┼────────────┤');
  672.         For cnt:=0 To FileSize(qf)-1 Do begin
  673.           Read(qf,l);
  674.           tab (^P'│ '^S+l.name,37);
  675.           tab (^P'│ '^S+(datestr(l.when)),15);
  676.           tab (^P'│ '^S+(timestr(l.when)),15);
  677.           tab (^P'│ '^S+l.baud,15);
  678.           writeln (^P'│');
  679.           if Break then Exit;
  680.           End;
  681.     writeln (^P'└──────────────────────────────────┴────────────┴────────────┴────────────┘'^M);
  682.           Close(qf)
  683.         End;
  684.         End;
  685.  
  686. procedure infoform (i:integer);
  687. var ff:text;
  688.     fn:lstr;
  689.     k:char;
  690.     me:message;
  691. begin
  692.   writeln;
  693.   if (i<1) or (i>5) then exit;
  694.   fn:=textfiledir+'Infoform.'+strr(i);
  695.   if not exist (fn) then begin
  696.     writestr ('There isn''t an Info-Form #'+strr(i)+' right now.');
  697.     if issysop then
  698.       writeln ('Sysop: To make an information form, create a text file',
  699.              ^M'called ',fn,'.  Use * to indicate a pause for user input.');
  700.     exit
  701.   end;
  702.   if i=1 then begin
  703.   if urec.infoform1<>-1 then begin
  704.     writestr ('You have already filled out Information Form #1!  '+^M+
  705.               'Replace it [y/n]? *');
  706.     if not yes then exit;
  707.     deletetext (urec.infoform1);
  708.     urec.infoform1:=-1;
  709.     writeurec
  710.   end;
  711.   end;
  712.   if i=2 then begin
  713.   if urec.infoform2<>-1 then begin
  714.     writestr ('You have an existing information form #2!  '+^M+
  715.               'Replace it [y/n]? *');
  716.     if not yes then exit;
  717.     deletetext (urec.infoform2);
  718.     urec.infoform2:=-1;
  719.     writeurec
  720.   end;
  721.   end;
  722.   if i=3 then begin
  723.   if urec.infoform3<>-1 then begin
  724.     writestr ('You have an existing information form #3!  '+^M+
  725.               'Replace it [y/n]? *');
  726.     if not yes then exit;
  727.     deletetext (urec.infoform3);
  728.     urec.infoform3:=-1;
  729.     writeurec
  730.   end;
  731.   end;
  732.   if i=4 then begin
  733.   if urec.infoform4<>-1 then begin
  734.     writestr ('You have an existing information form #4!  '+^M+
  735.               'Replace it [y/n]? *');
  736.     if not yes then exit;
  737.     deletetext (urec.infoform4);
  738.     urec.infoform4:=-1;
  739.     writeurec
  740.   end;
  741.   end;
  742.   if i=5 then begin
  743.   if urec.infoform5<>-1 then begin
  744.     writestr ('You have an existing information form #5!  '+^M+
  745.               'Replace it [y/n]? *');
  746.     if not yes then exit;
  747.     deletetext (urec.infoform5);
  748.     urec.infoform5:=-1;
  749.     writeurec
  750.   end;
  751.   end;
  752.   assign (ff,fn);
  753.   reset (ff);
  754.   me.numlines:=1;
  755.   me.title:='';
  756.   me.anon:=false;
  757.   me.text[1]:='Filled out on: '+datestr(now)+' at '+timestr(now);
  758.   while not eof(ff) do begin
  759.     if hungupon then begin
  760.       textclose (ff);
  761.       exit
  762.     end;
  763.     read (ff,k);
  764.     if k='*' then begin
  765.       nochain:=true;
  766.       atmenu:=false;
  767.       getstr (1);
  768.       me.numlines:=me.numlines+1;
  769.       me.text[me.numlines]:=input
  770.     end else writechar (k)
  771.   end;
  772.   textclose (ff);
  773.   if i=1 then urec.infoform1:=maketext (me) else
  774.   if i=2 then urec.infoform2:=maketext (me) else
  775.   if i=3 then urec.infoform3:=maketext (me) else
  776.   if i=4 then urec.infoform4:=maketext (me) else
  777.   if i=5 then urec.infoform5:=maketext (me);
  778.   writeurec
  779. end;
  780.  
  781. procedure openusfile;
  782. const newusers:userspecsrec=(name:'New users';minlevel:1;maxlevel:1;
  783.          minlaston:-maxint;maxlaston:maxint;minpcr:-maxint;maxpcr:maxint);
  784. begin
  785.   assign (usfile,bbsdatadir+'userspec.dat');
  786.   reset (usfile);
  787.   if ioresult<>0 then begin
  788.     rewrite (usfile);
  789.     if logonlevel<>0 then newusers.maxlevel:=logonlevel;
  790.     write (usfile,newusers)
  791.   end
  792. end;
  793.  
  794. procedure editspecs (var us:userspecsrec);
  795.  
  796.   procedure get (tex:string; var value:integer; min:boolean);
  797.   var vstr:sstr;
  798.   begin
  799.     buflen:=6;
  800.     if abs(value)=maxint then vstr:='None' else vstr:=strr(value);
  801.     writestr (tex+' ['+vstr+']:');
  802.     if input[0]<>#0
  803.       then if upcase(input[1])='N'
  804.         then if min
  805.           then value:=-maxint
  806.           else value:=maxint
  807.         else value:=valu(input)
  808.   end;
  809.  
  810.   procedure getreal (tex:string; var value:real; min:boolean);
  811.   var vstr:sstr;
  812.       s:integer;
  813.   begin
  814.     buflen:=10;
  815.     if abs(value)=maxint then vstr:='None' else vstr:=streal(value);
  816.     writestr (tex+' ['+vstr+']:');
  817.     if length(input)<>0
  818.       then if upcase(input[1])='N'
  819.         then if min
  820.           then value:=-maxint
  821.           else value:=maxint
  822.         else begin
  823.           val (input,value,s);
  824.           if s<>0 then value:=0
  825.         end
  826.   end;
  827.  
  828. begin
  829.   writeln (^B^M'Enter Specifications; N for none.'^M);
  830.   buflen:=30;
  831.   writestr ('Specification set name ['+us.name+']:');
  832.   if length(input)<>0
  833.     then if match(input,'N')
  834.       then us.name:='Unnamed'
  835.       else us.name:=input;
  836.   get ('Lowest level',us.minlevel,true);
  837.   get ('Highest level',us.maxlevel,true);
  838.   get ('Lowest #days since last call',us.minlaston,true);
  839.   get ('Highest #days since last call',us.maxlaston,true);
  840.   getreal ('Lowest post to call ratio',us.minpcr,true);
  841.   getreal ('Highest post to call ratio',us.maxpcr,true)
  842. end;
  843.  
  844. function getspecs (var us:userspecsrec):integer; { -1:not saved   >0:in file }
  845. begin
  846.   with us do begin
  847.     name:='Unnamed';                     { Assumes USFILE is open !! }
  848.     minlevel:=-maxint;
  849.     maxlevel:=maxint;
  850.     minlaston:=-maxint;
  851.     maxlaston:=maxint;
  852.     minpcr:=-maxint;
  853.     maxpcr:=maxint
  854.   end;
  855.   editspecs (us);
  856.   writestr (^M'Save these specs to disk? *');
  857.   if yes then begin
  858.     seek (usfile,filesize(usfile));
  859.     write (usfile,us);
  860.     getspecs:=filesize(usfile)
  861.   end else getspecs:=-1
  862. end;
  863.  
  864. function searchspecs (var us:userspecsrec; name:mstr):integer;
  865. var v,pos:integer;
  866. begin
  867.   v:=valu(name);
  868.   seek (usfile,0);
  869.   pos:=1;
  870.   while not eof(usfile) do begin
  871.     read (usfile,us);
  872.     if match(us.name,name) or (valu(name)=pos) then begin
  873.       searchspecs:=pos;
  874.       exit
  875.     end;
  876.     pos:=pos+1
  877.   end;
  878.   searchspecs:=0;
  879.   writestr (^M'Not found!')
  880. end;
  881.  
  882. procedure listspecs;
  883. var us:userspecsrec;
  884.     pos:integer;
  885.  
  886.   procedure writeval (n:integer);
  887.   begin
  888.     if abs(n)=maxint then write ('   None') else write(n:7)
  889.   end;
  890.  
  891.   procedure writevalreal (n:real);
  892.   begin
  893.     if abs(n)=maxint then write ('   None') else write(n:7:2)
  894.   end;
  895.  
  896. begin
  897.   writehdr ('User Specification Sets');
  898.   seek (usfile,0);
  899.   pos:=0;
  900.   tab ('',35);
  901.   tab ('    Level    ',14);
  902.   tab ('  Last Call  ',14);
  903.   writeln ('  Post/Call Ratio  ');
  904.   while not (break or eof(usfile)) do begin
  905.     pos:=pos+1;
  906.     read (usfile,us);
  907.     write (pos:3,'. ');
  908.     tab (us.name,30);
  909.     writeval (us.minlevel);
  910.     writeval (us.maxlevel);
  911.     writeval (us.minlaston);
  912.     writeval (us.maxlaston);
  913.     writevalreal (us.minpcr);
  914.     writevalreal (us.maxpcr);
  915.     writeln
  916.   end
  917. end;
  918.  
  919. function selectaspec (var us:userspecsrec):integer; {  0 = none         }
  920. var done:boolean;                                   { -1 = not in file  }
  921.     pos:integer;                                    { -2 = added to end }
  922. begin
  923.   selectaspec:=0;
  924.   openusfile;
  925.   if filesize(usfile)=0
  926.     then selectaspec:=getspecs(us)
  927.     else
  928.       repeat
  929.         if hungupon then exit;
  930.         done:=false;
  931.         writestr (^M'Specification Set Name (?/List, A/Add):');
  932.         if length(input)=0
  933.           then done:=true
  934.           else if match(input,'A')
  935.             then
  936.               begin
  937.                 pos:=getspecs(us);
  938.                 if pos>0
  939.                   then selectaspec:=-2
  940.                   else selectaspec:=-1;
  941.                 done:=true
  942.               end
  943.             else if match(input,'?')
  944.               then listspecs
  945.               else
  946.                 begin
  947.                   pos:=searchspecs (us,input);
  948.                   done:=pos<>0;
  949.                   selectaspec:=pos
  950.                 end
  951.       until done;
  952.   close (usfile)
  953. end;
  954.  
  955. function selectspecs (var us:userspecsrec):boolean;
  956. var dummy:integer;
  957. begin
  958.   dummy:=selectaspec (us);
  959.   selectspecs:=dummy=0
  960. end;
  961.  
  962. procedure deletespecs (pos:integer);
  963. var cnt:integer;
  964.     us:userspecsrec;
  965. begin
  966.   openusfile;
  967.   for cnt:=pos to filesize(usfile)-1 do begin
  968.     seek (usfile,cnt);
  969.     read (usfile,us);
  970.     seek (usfile,cnt-1);
  971.     write (usfile,us)
  972.   end;
  973.   seek (usfile,filesize(usfile)-1);
  974.   truncate (usfile);
  975.   close (usfile)
  976. end;
  977.  
  978. procedure editoldspecs;
  979. var pos:integer;
  980.     us:userspecsrec;
  981. begin
  982.   repeat
  983.     pos:=selectaspec (us);
  984.     if pos>0 then begin
  985.       buflen:=1;
  986.       writestr (^M'[E]dit or [D]elete? *');
  987.       if length(input)=1 then case upcase(input[1]) of
  988.         'E':begin
  989.               editspecs (us);
  990.               openusfile;
  991.               seek (usfile,pos-1);
  992.               write (usfile,us);
  993.               close (usfile)
  994.             end;
  995.         'D':deletespecs (pos)
  996.       end
  997.     end
  998.   until (pos=0) or hungupon
  999. end;
  1000.  
  1001. begin
  1002.  buflen30:=false;
  1003. end.
  1004.